home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
Yerk 3.64
/
tool+
/
popUpMenus
< prev
next >
Wrap
Text File
|
1993-06-23
|
4KB
|
136 lines
\ stringvar - class of strings which are kept in memory
\ as barrays and have a max length - from mh
\ 5.24.89 rfl twidth and type replaces stringwidth and drawstring
\ inset rect before print and changed 2 to 1 in justification
\ 12.4.89 rfl a few modifications cosmetic
\ 5.24.90 rfl redid justinbox stuff to shorten code
\ 7.12.92 rfl deleted stringvar class
\ 5.20.93 rfl removed cursor stuff
\ Bitmap class for drawing bitmaps to screen
:CLASS bMap <Super warray
Var BaseAddr
Int RowBytes
Rect BndsRect
rect DestRect
\ ( n l t r b -- )
:M INIT: Put: bndsRect Put: RowBytes ;M
:M putDest: { x y \ x0 y0 -- } size: BndsRect -> y0 -> x0
x y x0 x + y0 y + put: destRect ;M
:M draw: idxbase +base Put: BaseAddr
abs: self portBit: actw
abs: BndsRect abs: destRect
word0 0 call copyBits ;M
:M offset: ( dx dy -- ) offset: destrect ;M
:M moveto: ( x y -- ) putDest: self draw: self ;M
;CLASS
5 bmap darrow \ instantiate a global down pointing arrow
hex
$ ff80 $ 7f00 $ 3e00 $ 1c00 $ 0800 put: darrow
decimal
2 0 0 9 5 init: darrow
\ draw text string justified in a given rectangle
: ctextbox { addr len arect just -- }
addr +base len aRect +base just makeint call textbox ;
\ definition of class that handles popup menus
\ popupRect provides a way to use pmenu
\ two kinds of disp/print are supported:
\ display a fixed name string or
\ display the last selected item in menu
:CLASS popUpMenu <super pMenu
int dmode \ display mode: ITEM (0) or NAME (1)
var myAction \ Menu has an action independent of item handler
var myWindow \ owning window
33 bytes name \ string holds name of rect...limited to 32 characters
int txFont \ retains its type of font
int txSize
int txFace
int txJust \ justification left(0), center(1), right(-1)
rect myBorder \ rectangle framing menu
:M placeDarrow: getBotX: myBorder
13 - size: myBorder swap drop 2/ getTopY: myBorder + 2- putDest: darrow ;M
\ *** initializing methods ***
:M font: ( font size face -- ) put: txFace put: txSize put: txFont ;M
:M justify: put: txJust ;M
:M actions: put: myAction ;M
:M putWindow: put: myWindow ;M
:M setMode: ( displayMode -- ) put: dmode ;M
:M putRect: ( l t r b -- ) put: myBorder placeDarrow: self
getTop: myBorder offset: self ;M
:M initFont: pushPort set: [ obj: myWindow ]
get: txFont tfont get: txSize tsize get: txFace tface popPort ;M
:M getRect: ( -- topx topy botx boty ) get: myBorder ;M
:M name: ( addr len -- ) dup 32 > classerr" 133 addr: name >str255 drop ;M
:M getName: ( -- addr len ) addr: name count ;M
:M print: ( -- ) actw obj: myWindow -> actw
2 1 inset: myBorder getBotX: myBorder dup 10 - putBotX: myBorder
1 tmode initFont: self
getName: self addr: myBorder get: txJust ctextBox
putBotX: myBorder -2 -1 inset: myBorder placeDarrow: self draw: darrow
-> actw ;M
:M draw: ( -- ) pushPort set: [ obj: myWindow ]
1 1 offset: myBorder draw: myBorder
-1 -1 offset: myBorder clear: myBorder draw: myBorder print: self popPort ;M
:M ptIn: ( point --) ptIn: myBorder ;M
:M exec: ( -- ) where: theMouse pack ptin: self
IF popup: self
get: dmode 0=
IF mitem 0>
IF mitem checkOne: self mitem 1- getText: self name: self print: self THEN
THEN
exec: myAction
THEN ;M
\ :M firstName: get: dmode 0=
\ IF getItem: self get: super
\ name: self print: self
\ THEN ;M
:M classinit: ( -- ) classinit: super
12 put: txSize 1 put: type nullcfa put: myAction ;M
;CLASS
\ EXAMPLE - create a menu in a resource file with ID 128 and 4 items
\ " .rsrc" openresfile
\
\ 4 popUpMenu SampleMen \ instantiate
\ : itemHandler home mitem . ;
\ 4 'cfas itemHandler itemHandler itemHandler itemHandler 128 put: SampleMen
\ fwind putWindow: SampleMen
\
\ 240 18 320 34 putRect: SampleMen
\ 0 12 0 font: SampleMen
\ konstant tejustleft justify: SampleMen
\
\ getnew: SampleMen \ read menu from resource file
\ insert: SampleMen \ insert it into the menubar
\
\ : doSample exec: sampleMen ;
\ : drawSample draw: sampleMen ;
\ 4 'cfas null null drawSample doSample actions: fwind
\
\ draw: sampleMen